home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 011 / utility.arc / UTILITYC.BAS < prev    next >
Encoding:
BASIC Source File  |  1985-04-09  |  20.0 KB  |  442 lines
  1. 5 DEFDBL D
  2. 6 BLNK$="           "
  3. 10 ON ERROR GOTO 3000
  4. 20 DIM OT(32,2),F(32),D(32),F1(32),D1(32),F2(32),D2(32)
  5. 30 DIM ITEMSEL(32),DCT1$(32),DCT2$(32),RE$(278),RB$(278)
  6. 40 REM
  7. 50 CLS
  8. 55 CLOSE
  9. 56 FLAG=0
  10. 60 PRINT "MASTER MENU"
  11. 70 PRINT "---------------------------------------------------------------
  12. 80 PRINT "1. LIST FILE NAMES"
  13. 90 PRINT "2. LIST DATA DICTIONARY FOR A DATA FILE"
  14. 100 PRINT "3. LIST DATA FROM A DATA FILE"
  15. 110 PRINT "4. PRODUCE A SUBSET OF A DATA FILE (VERTICAL AND/OR HORIZONTAL)"
  16. 120 PRINT "5. COMBINE TWO INPUT FILES INTO ONE OUTPUT FILE (VERTICAL)"
  17. 125 PRINT "6. PRODUCE COPY OF FILE WITH AREA NAMES AND CODES ADDED.
  18. 130 PRINT "7. FINISHED WITH UTILITY PROGRAM
  19. 140 PRINT "---------------------------------------------------------------
  20. 145 PRINT
  21. 150 INPUT "ENTER NUMBER : ",DUM$
  22. 152 GOSUB 3030 : IF FLAG=1 THEN GOSUB 3150 : GOTO 150
  23. 160 ON VAL(DUM$) GOTO 1120,1180,1270,1970,2100,2780,180
  24. 170 INPUT "INPUT OUT OF RANGE. HIT RETURN TO CONTINUE",DUM$ : GOTO 40
  25. 180 SYSTEM
  26. 190 INPUT "ENTER INPUT FILE NAME : ",INFILE$ : OPEN "I",#1,INFILE$+".TXT"
  27. 192 IF INSTR(INFILE$,".") THEN INPUT "DO NOT USE EXTENSION. HIT RETURN TO CONTINUE.",DUM$ : CLOSE#1 : FLAG=0 : GOTO 190
  28. 199 IF FLAG=1 THEN GOSUB 3180 : CLOSE#1 : GOTO 190
  29. 200 FLAG=0 : OPEN"I",#3,INFILE$+".DCT"
  30. 201 IF FLAG=1 THEN GOSUB 3230 : GOTO 190
  31. 210 ITEMCTR=0 : SELCTR=0
  32. 220 WHILE NOT EOF(3) : ITEMCTR=ITEMCTR+1 : LINE INPUT#3,DCT1$(ITEMCTR) : WEND
  33. 230 CLOSE#3
  34. 240 PRINT ITEMCTR;" ITEMS IN THIS FILE."
  35. 250 INCTR=ITEMCTR
  36. 260 PRINT
  37. 270 RETURN '-----------
  38. 280 INPUT "ENTER OUTPUT FILE NAME : ",OUTFILE$
  39. 290 FLAG=0 : OPEN "O",#2,OUTFILE$+".TXT"
  40. 295 GOSUB 3310
  41. 300 RETURN '-----------
  42. 310 '---- BEGIN RANGE SELECT -----
  43. 320 LINE INPUT "DO YOU WISH TO SELECT A SUBSET OF RECORDS ? (YES/NO) : ",S$
  44. 330 IF S$="N" OR S$="n" THEN RB$(1)="00000" : RE$(1)="56045" : RANGECTR=1 : GOTO 1000
  45. 340 '--- ENTRY POINT TWO
  46. 350 PRINT : PRINT "RECORD SUBSET SPECIFICATION OPTIONS
  47. 360 PRINT "-----------------------------------------------
  48. 370 PRINT "1. USE CURRENT STATE-COUNTY CODE SPECIFICATIONS"
  49. 380 PRINT "2. DISPLAY CURRENT SPECIFICATIONS
  50. 390 PRINT "3. OBTAIN SPECIFICATIONS FROM A FILE"
  51. 400 PRINT "4. SAVE CURRENT SPECIFICATIONS INTO A FILE"
  52. 410 PRINT "5. ENTER NEW SPECIFICATIONS
  53. 415 PRINT "6. RETURN TO MASTER MENU
  54. 420 PRINT "-----------------------------------------------
  55. 430   INPUT "ENTER NUMBER : ",DUM$
  56. 435   GOSUB 3030 : IF FLAG=1 THEN GOSUB 3150 : GOTO 430
  57. 440   SEL=VAL(DUM$) : IF SEL<1 OR SEL>6 THEN GOSUB 3150 : GOTO 430
  58. 450 ON SEL GOTO 460,510,530,470,570,40
  59. 460 IF LEN(RE$(1))>0 THEN 1000 ELSE PRINT "CURRENT RANGE SPECS NOT AVAILABLE." :  INPUT "HIT RETURN TO CONTINUE.",DUM$ : GOTO 340
  60. 470 INPUT "ENTER NEW FILE NAME : ",SPECFILE$
  61. 471 FLAG=0 : OPEN "I",#3,SPECFILE$ : IF FLAG=0 THEN 479
  62. 472   PRINT "FILE WITH THIS NAME ALREADY PRESENT." : INPUT "HIT JUST RETURN TO CONTINUE. HIT 'X' THEN RETURN TO CANCEL.",DUM$
  63. 474   IF LEN(DUM$)>0 THEN 340
  64. 479 CLOSE#3
  65. 480 FLAG=0 : OPEN "O",#3,SPECFILE$
  66. 485 IF FLAG=1 THEN GOSUB 3310 : GOTO 340
  67. 490 FOR I=1 TO RANGECTR : WRITE#3,RB$(I),RE$(I) : NEXT
  68. 500 CLOSE#3 : PRINT RANGECTR;" RANGE SPECS OUTPUT" : GOTO 340 '--------------
  69. 510 'BLOCK TO DISPLAY CURRENT SPECS ----------
  70. 512 PRINT
  71. 513 PRINT "AREAS CURRENTLY SPECIFIED
  72. 514 PRINT "-------------
  73. 516 FOR I=1 TO RANGECTR
  74. 517   IF RB$(I)=RE$(I) THEN PRINT RB$(I) ELSE PRINT RB$(I)+"-"+RE$(I)
  75. 518 NEXT
  76. 520 PRINT "-------------
  77. 525 INPUT "HIT RETURN TO CONTINUE.",DUM$ : GOTO 340
  78. 530 ' BLOCK TO GET SPECS ------
  79. 531 INPUT "ENTER NAME OF FILE CONTAINING SPECS : ",SPECFILE$
  80. 533 RANGECTR=0
  81. 540 FLAG=0 : OPEN "I",#3,SPECFILE$
  82. 542 IF FLAG=1 THEN PRINT "SPEC FILE NOT FOUND ON DRIVE SPECIFIED." : INPUT "HIT JUST RETURN TO TRY AGAIN. HIT 'X' THEN HIT RETURN TO CANCEL",DUM$ : IF LEN(DUM$)>0 THEN 350 ELSE 530
  83. 550 WHILE NOT EOF(3) : RANGECTR=RANGECTR+1 : INPUT#3,RB$(RANGECTR),RE$(RANGECTR) : WEND
  84. 560 CLOSE#3 : PRINT : PRINT RANGECTR;" RANGE SPECS INPUT"
  85. 561 GOSUB 773 : GOTO 340
  86. 565 'END BLOCK -----------------
  87. 570 RANGECTR=1
  88. 575 PRINT
  89. 580 PRINT "ENTER STATE-COUNTY CODES. THREE FORMS ARE VALID."
  90. 585 PRINT "-------------------------------------------------------------------------
  91. 590 PRINT "FORM 1 : <GEOCODE>-<GEOCODE>            SPECIFIES A RANGE
  92. 600 PRINT "FORM 2 : <GEOCODE>                      SPECIFIES A SINGLE AREA."
  93. 605 PRINT "GEOCODE FOR COUNTIES IS 5 DIGITS : <STATE CODE><COUNTY CODE>
  94. 606 PRINT "GEOCODE FOR CITIES IS 6 DIGITS   : <STATE CODE><CITY CODE>
  95. 610 PRINT "FORM 3 : SAME AS FORM 2 BUT CONTAINING DON'T CARE CHARACTERS ('?')."
  96. 620 PRINT "E.G. ??000 FOR COUNTIES SPECIFIES A GROUP OF 52 RECORDS, THE U.S. TOTAL RECORD"
  97. 630 PRINT "50 STATE TOTAL RECORDS AND A RECORD FOR THE DISTRICT OF COLUMBIA."
  98. 640 PRINT "FORM 3 MUST BE USED ALONE. FORMS 1 AND 2 MAY BE INTERMIXED AND REPEATED"
  99. 650 PRINT "BUT ALL CODES MUST BE IN ASCENDING SEQUENCE."
  100. 660 PRINT "-------------------------------------------------------------------------
  101. 670 INPUT "ENTER CODE(S) OR 'END' : ",DUM$
  102. 680 GOSUB 920 'SQUEEZE OUT BLANKS
  103. 690 IF LEN(DUM$)=5 OR LEN(DUM$)=6 OR (INSTR(DUM$,"-")<>0 AND (LEN(DUM$)=11 OR LEN(DUM$)=13)) THEN GOTO 730
  104. 700 IF DUM$ <>"END" THEN 720
  105. 710   RANGECTR=RANGECTR-1 : GOSUB 773 : GOTO 340
  106. 720   PRINT "INVALID INPUT. REENTER." : GOTO 670
  107. 730 IF LEN(DUM$)=5 OR LEN(DUM$)=6 THEN GOTO 750
  108. 740   IF INSTR(DUM$,"-")=6 THEN RB$(RANGECTR)=LEFT$(DUM$,5) : RE$(RANGECTR)=RIGHT$(DUM$,5) : GOTO 872
  109. 741   IF INSTR(DUM$,"-")=7 THEN RB$(RANGECTR)=LEFT$(DUM$,6) : RE$(RANGECTR)=RIGHT$(DUM$,6) : GOTO 872
  110. 742 RANGECTR=RANGECTR+1 : GOTO 670
  111. 750 IF INSTR(DUM$,"?") THEN GOTO 770
  112. 760   RB$(RANGECTR)=DUM$ : RE$(RANGECTR)=DUM$ : RANGECTR=RANGECTR+1 : GOTO 670
  113. 770 IF RANGECTR=1 THEN GOSUB 790 : PRINT RANGECTR;" AREA CODES SELECTED." ELSE PRINT "FORM 3 NOT ALLOWED IN COMBINATION WITH OTHER FORMS. LAST ENTRY IGNORED." : GOTO 670
  114. 771 GOSUB 773 : GOTO 340
  115. 773 PRINT "THE AREA CODES SELECTED ARE NOW THE CURRENT SPECIFICATIONS."
  116. 775 INPUT "HIT RETURN TO CONTINUE.",DUM$
  117. 776 PRINT
  118. 779 RETURN
  119. 780   PRINT "FORM 3 NOT VALID IN COMBINATION WITH OTHER REQUESTS. REQUEST DENIED." : INPUT "HIT RETURN TO CONTINUE.",DUM$ : GOTO 670
  120. 790 'SUB TO USE WILD CHARS (?) TO COLLECT SELECTION SET -----------------------
  121. 795 RANGECTR=0
  122. 800 WHILE NOT EOF(1)
  123. 810   GOSUB 1710
  124. 815   IF MID$(DUM$,1,1)<>"?" THEN IF MID$(ID$,1,1)>MID$(DUM$,1,1) THEN 865 ELSE IF MID$(DUM$,2,1)<>"?" AND MID$(ID$,1,1)=MID$(DUM$,1,1) AND MID$(ID$,2,1)>MID$(DUM$,2,1) THEN 865 '-- 2 EXIT CONDITIONS --
  125. 820   FOR I=1 TO LEN(DUM$)
  126. 830     IF MID$(DUM$,I,1)="?" THEN 840 ELSE IF MID$(DUM$,I,1)=MID$(ID$,I,1) THEN 840 ELSE 860
  127. 840   NEXT
  128. 850 RANGECTR=RANGECTR+1 : RB$(RANGECTR)=ID$ : RE$(RANGECTR)=ID$
  129. 855 PRINT ID$; " SELECTED"
  130. 860 WEND
  131. 865 CLOSE#1
  132. 866 OPEN "I",#1,INFILE$+".TXT"
  133. 870 RETURN '-------------
  134. 872 'SUB TO CHECK CODE(S) RANGES
  135. 873 IF RB$(RANGECTR)>RE$(RANGECTR) THEN PRINT "LAST ENTRY REJECTED. RANGE START>RANGE END." : INPUT "HIT RETURN TO CONTINUE.",DUM$ : GOTO 670
  136. 875 IF RANGECTR>1 THEN IF RB$(RANGECTR)<RE$(RANGECTR-1) THEN PRINT "LAST ENTRY REJECTED. RANGE START<PRECEEDING RANGE END." : INPUT "HIT RETURN TO CONTINUE.",DUM$ : GOTO 670
  137. 877 GOTO 742 ' END BLOCK
  138. 920 'SUB TO SQUEEZE BLANKS FROM DUM$ -------------
  139. 930 WHILE INSTR(DUM$," ")<>0
  140. 940   FOR I=INSTR(DUM$," ") TO LEN(DUM$)-1
  141. 950     MID$(DUM$,I,1)=MID$(DUM$,I+1,1)
  142. 960   NEXT
  143. 970   DUM$=MID$(DUM$,1,LEN(DUM$)-1)
  144. 980 WEND
  145. 990 RETURN '--------------------------------------
  146. 1000 '----- END OF RANGE SELECT ---- BEGIN ITEM SELECT
  147. 1010 SELCTR=0 : ITEMSELECT=0
  148. 1020 PRINT
  149. 1030 LINE INPUT "DO YOU WISH TO SELECT A SUBSET OF ITEMS (YES/NO) ? : ",YORN$
  150. 1035 GOSUB 3100 : IF FLAG<0 THEN GOSUB 3150 : GOTO 1030
  151. 1040 IF FLAG=1 THEN 1110 'NO
  152. 1050 PRINT "ENTER ITEM NUMBER TO SELECT (1-";ITEMCTR;")"; : INPUT "(OR 'END') : ",DUM$
  153. 1060 IF INSTR(DUM$,"E") OR INSTR(DUM$,"e") THEN 1100
  154. 1065 GOSUB 3100 : IF FLAG=1 THEN GOSUB 3150 : GOTO 1050
  155. 1070 SEL=VAL(DUM$) : SELCTR=SELCTR+1
  156. 1080 ITEMSEL(SELCTR)=SEL
  157. 1090 GOTO 1050
  158. 1100 ITEMSELECT=1
  159. 1110 RETURN
  160. 1120 '************ FILES ON DISK **************
  161. 1130 INPUT "ENTER 'A' FOR A DRIVE, 'B' FOR B DRIVE : ",DUM$
  162. 1140 IF INSTR(DUM$,"A")>0 OR INSTR(DUM$,"a")>0 THEN FILES "A:*.*" : PRINT
  163. 1150 IF INSTR(DUM$,"B")>0 OR INSTR(DUM$,"b")>0 THEN FILES "B:*.*" : PRINT
  164. 1160 INPUT "HIT RETURN TO CONTINUE";DUM$
  165. 1170 GOTO 40
  166. 1180 '************ LIST DATA DICTIONARY *******
  167. 1190 INPUT "ENTER FILE NAME : ",FILE$
  168. 1195 IF INSTR(FILE$,".") THEN GOSUB 3280 : GOTO 1190
  169. 1200 FLAG=0 : OPEN "I",#1,FILE$+".DCT"
  170. 1202 IF FLAG=1 THEN GOSUB 3230 : GOTO 1190
  171. 1210 PRINT
  172. 1212 PRINT "DATA DICTIONARY FOR FILE : "+FILE$
  173. 1214 PRINT "--------------------------------------
  174. 1220 CTR=0 : WHILE NOT EOF(1) : CTR=CTR+1 : LINE INPUT#1,A$ : PRINT CTR;" ";A$ : WEND
  175. 1230 CLOSE#1
  176. 1235 PRINT "-------------------------------------
  177. 1250 INPUT "HIT RETURN TO CONTINUE",DUM$
  178. 1260 GOTO 40
  179. 1270 '************ LIST DATA ******************
  180. 1280 GOSUB 190 : GOSUB 310 : EX=0 : GOSUB 1290 : CLOSE : GOTO 40
  181. 1290 IF ITEMSELECT=O AND ITEMCTR>6 THEN ITEMCTR=6 : GOSUB 1320 : GOTO 1350
  182. 1300 IF ITEMSELECT=1 AND SELCTR>6 THEN SELCTR=6 : GOSUB 1320 : GOTO 1350
  183. 1310 GOTO 1350
  184. 1320 PRINT : PRINT "MORE THAN 6 ITEMS REQUESTED. ONLY FIRST SIX WILL BE LISTED."
  185. 1330 INPUT "HIT RETURN TO CONTINUE.",DUM$
  186. 1340 RETURN '-----------
  187. 1350 'OLD CTR=1. NOW ENTRY POINT ONLY.
  188. 1390 PRINT
  189. 1400 IF EX=0 THEN PRINT "  ID   ";
  190. 1410 IF EX=0 THEN IF ITEMSELECT=0 THEN GOSUB 1430 : GOSUB 1470 ELSE GOSUB 1500 : GOSUB 1530
  191. 1420 GOTO 1560
  192. 1430 '----  HEADER ROUTINES ----- FIRST NO SELECT
  193. 1440 FOR I=1 TO ITEMCTR-1 : PRINT " ";:PRINT LEFT$(BLNK$,3)+LEFT$(DCT1$(I),8); : NEXT
  194. 1450 PRINT " "; : PRINT LEFT$(BLNK$,3)+LEFT$(DCT1$(ITEMCTR),8)
  195. 1460 RETURN '-----------
  196. 1470 PRINT "------  ";
  197. 1480 FOR I=1 TO ITEMCTR-1 : PRINT "----------- "; : NEXT : PRINT "-----------"
  198. 1490 RETURN ' -------
  199. 1500 '--------------------------- NEXT WITH SELECT
  200. 1510 FOR I=1 TO SELCTR-1 : PRINT "    "+LEFT$(DCT1$(ITEMSEL(I)),8); : NEXT
  201. 1520 PRINT "    "+LEFT$(DCT1$(ITEMSEL(SELCTR)),8) : RETURN
  202. 1530 PRINT "------  ";
  203. 1540 FOR I=1 TO SELCTR-1 : PRINT "----------- "; : NEXT : PRINT "-----------"
  204. 1550 RETURN ' -------
  205. 1560 CTR=0
  206. 1565 GOSUB 1710
  207. 1570 FOR X=1 TO RANGECTR
  208. 1590 WHILE ID$<RB$(X) AND NOT EOF(1) : GOSUB 1710 : WEND
  209. 1600 WHILE NOT EOF(1) AND ID$>=RB$(X) AND ID$<=RE$(X)
  210. 1610  GOSUB 1730 ' OUTPUT DRIVER
  211. 1620  GOSUB 1710
  212. 1625  IF X=RANGECTR THEN IF MID$(ID$,1,2)>MID$(RE$(RANGECTR),1,2) THEN GOTO 1660
  213. 1630 WEND
  214. 1640 IF EOF(1) AND ID$<=RE$(X) THEN GOSUB 1730 : GOTO 1660
  215. 1650 NEXT
  216. 1660 IF EX=0 THEN IF ITEMSELECT=0 THEN GOSUB 1470 ELSE GOSUB 1530
  217. 1670 IF EX=0 THEN PRINT CTR;" RECORDS LISTED"
  218. 1680 IF EX=1 THEN PRINT CTR;" RECORDS PLACED IN OUTPUT FILE : ";OUTFILE$+".TXT"
  219. 1690 INPUT "HIT RETURN TO CONTINUE.",DUM$
  220. 1700 RETURN
  221. 1710 INPUT#1,ID$ : FOR I=1 TO INCTR : INPUT#1,F(I),D(I) : NEXT
  222. 1720 RETURN '-----------
  223. 1730 '---- OUTPUT DRIVER ROUTINE
  224. 1740 CTR=CTR+1
  225. 1750  IF EX=0 THEN IF ITEMSELECT=0 THEN GOSUB 1780 ELSE GOSUB 1820
  226. 1760  IF EX=1 THEN IF ITEMSELECT=0 THEN GOSUB 1870 ELSE GOSUB 1930
  227. 1770 RETURN
  228. 1780 '---- LIST OUTPUT ROUTINES
  229. 1790 PRINT USING "\    \";ID$; : PRINT " "; : FOR I=1 TO ITEMCTR-1 : PRINT USING "##";F(I); : PRINT USING "##########";D(I); : NEXT
  230. 1800 PRINT USING "##";F(ITEMCTR); : PRINT USING "##########";D(ITEMCTR)
  231. 1810 RETURN '----
  232. 1820 PRINT USING "\    \";ID$; : PRINT " "; : FOR I=1 TO SELCTR-1
  233. 1830 PRINT USING "##";F(ITEMSEL(I)); : PRINT USING "##########";D(ITEMSEL(I));
  234. 1840 NEXT
  235. 1850 PRINT USING "##";F(ITEMSEL(SELCTR)); : PRINT USING "##########";D(ITEMSEL(SELCTR))
  236. 1860 RETURN
  237. 1870 '----- EXTRACT OUTPUT ROUTINES ----
  238. 1880 PRINT ID$;" SELECTED"
  239. 1890 PRINT#2,ID$;",";
  240. 1900 FOR I=1 TO ITEMCTR-1 : PRINT#2,F(I);",";D(I);","; : NEXT
  241. 1910 PRINT#2,F(ITEMCTR);",";D(ITEMCTR)
  242. 1920 RETURN ' -----
  243. 1930 PRINT ID$;" SELECTED"
  244. 1940 PRINT#2,ID$;",";
  245. 1950 FOR I=1 TO SELCTR-1 : PRINT#2,F(ITEMSEL(I));",";D(ITEMSEL(I));","; : NEXT
  246. 1960 PRINT#2,F(ITEMSEL(SELCTR));",";D(ITEMSEL(SELCTR))
  247. 1965 RETURN '---------
  248. 1970 '************ EXTRACT ********************
  249. 1980 GOSUB 190
  250. 1990 GOSUB 280
  251. 1995 IF FLAG=1 THEN GOSUB 3310 : GOTO 40
  252. 2000 GOSUB 310
  253. 2010 EX=1
  254. 2020 GOSUB 1350
  255. 2030 OPEN "O",#3,OUTFILE$+".DCT"
  256. 2040 IF ITEMSELECT=1 THEN GOTO 2070
  257. 2050 FOR I=1 TO ITEMCTR : PRINT#3,DCT1$(I) : NEXT
  258. 2060 GOTO 2080
  259. 2070 FOR I=1 TO SELCTR : PRINT#3,DCT1$(ITEMSEL(I)) : NEXT
  260. 2080 CLOSE
  261. 2090 GOTO 40
  262. 2100 '********** COMBINE TWO FILES ************
  263. 2110 PRINT "THIS FUNCTION ASSUMES THAT THE TWO INPUT FILES HAVE THE SAME RECORD COUNT"
  264. 2120 PRINT "AND ARE IN THE SAME SEQUENCE."
  265. 2130 PRINT "ANY MATCH FAILURE WILL RESULT IN TERMINATION OF THE REQUEST AND DELETION OF"
  266. 2140 PRINT "THE OUTPUT FILE. THE TWO MISMATCHED IDS WILL BE PRINTED."
  267. 2150 PRINT
  268. 2160  INPUT "ENTER INPUT 1 FILE NAME (OR JUST RETURN TO CANCEL REQUEST) : ",IN1FILE$
  269. 2170 IF LEN(IN1FILE$)=0 THEN 40
  270. 2172 IF INSTR(IN1FILE$,".") THEN INPUT "DO NOT USE EXTENSION. HIT RETURN TO CONTINUE.",DUM$ : GOTO 2160
  271. 2180 FLAG=0 : OPEN "I",#1,IN1FILE$+".TXT"
  272. 2182 IF FLAG=1 THEN GOSUB 3180 : GOTO 2160
  273. 2190 FLAG=0 : OPEN "I",#3,IN1FILE$+".DCT"
  274. 2192 IF FLAG=1 THEN GOSUB 3230 : GOTO 2160
  275. 2200 CTR1=0 : WHILE NOT EOF(3)
  276. 2210  CTR1=CTR1+1 : LINE INPUT#3,DCT1$(CTR1)
  277. 2220 WEND
  278. 2230 CLOSE#3
  279. 2240 INPUT "ENTER INPUT 2 FILE NAME : ",IN2FILE$
  280. 2242 IF INSTR(IN2FILE$,".") THEN INPUT "DO NOT USE EXTENSION. HIT RETURN TO CONTINUE.",DUM$ : GOTO 2240
  281. 2250 FLAG=0 : OPEN "I",#2,IN2FILE$+".TXT"
  282. 2252 IF FLAG=1 THEN GOSUB 3180 : GOTO 2240
  283. 2260 FLAG=0 : OPEN "I",#3,IN2FILE$+".DCT"
  284. 2262 IF FLAG=1 THEN GOSUB 3230 : GOTO 2240
  285. 2270 CTR2=0
  286. 2280 WHILE NOT EOF(3)
  287. 2290   CTR2=CTR2+1 : LINE INPUT#3,DCT2$(CTR2)
  288. 2300 WEND
  289. 2310 CLOSE#3
  290. 2312 INPUT "ENTER OUTPUT FILE NAME : ",OUTFILE$
  291. 2315 FLAG=0 : OPEN "O",#3,OUTFILE$+".DCT"
  292. 2318 IF FLAG=1 THEN GOSUB 3310 : GOTO 40
  293. 2321 CLS
  294. 2322 PRINT "ITEM SELECTION AND ORDERING OPTIONS
  295. 2323 PRINT "-----------------------------------------------------------
  296. 2324 PRINT "1. ALL DATA ITEMS FROM BOTH INPUT FILES WILL BE PLACED IN
  297. 2325 PRINT "   THE OUTPUT FILE (INPUT FILE 1 SEQUENCE FOLLOWED BY INPUT
  298. 2326 PRINT "   FILE 2 SEQUENCE." : PRINT
  299. 2327 PRINT "2. USER WILL SELECT AND ORDER ITEMS
  300. 2328 PRINT "-----------------------------------------------------------
  301. 2329 INPUT "ENTER NUMBER : ",DUM$
  302. 2330 GOSUB 3030 : IF FLAG=1 THEN GOSUB 3150 : GOTO 2329
  303. 2331 SEL=VAL(DUM$)
  304. 2332 IF SEL<1 OR SEL>2 THEN GOSUB 3150 : GOTO 2329
  305. 2333 ON SEL GOSUB 2462,2339
  306. 2335 GOTO 2470
  307. 2339 PRINT : NOUT=1
  308. 2340 PRINT "SELECT ITEMS FROM EITHER INPUT FILE (1 OR 2) IN THE ORDER OF OUTPUT DESIRED."
  309. 2350 PRINT STRING$(75,"-")
  310. 2370 INPUT "ENTER FILE FROM WHICH NEXT ITEM IS TO BE TAKEN (1 OR 2) (OR 'END') : ",DUM$
  311. 2380 IF INSTR(DUM$,"END")>0 OR INSTR(DUM$,"end")>0 THEN NOUT=NOUT-1 : GOTO 2461
  312. 2385 GOSUB 3030 : IF FLAG=1 THEN GOSUB 3150 : GOTO 2370
  313. 2390 SEL=VAL(DUM$)
  314. 2395 IF SEL<1 OR SEL >2 THEN GOSUB 3150 : GOTO 2370
  315. 2400 OT(NOUT,2)=SEL
  316. 2410 INPUT "ENTER THE NUMBER OF THE DESIRED ITEM FROM THAT FILE : ",DUM$
  317. 2415 GOSUB 3030 : IF FLAG=1 THEN GOSUB 3150 : GOTO 2410
  318. 2420 SEL=VAL(DUM$)
  319. 2425 IF SEL<1 THEN GOSUB 3150 : GOTO 2410
  320. 2426 IF OT(NOUT,2)=1 THEN IF SEL>CTR1 THEN GOSUB 3150 : GOTO 2410
  321. 2427 IF OT(NOUT,2)=2 THEN IF SEL>CTR2 THEN GOSUB 3150 : GOTO 2410
  322. 2430 OT(NOUT,1)=SEL
  323. 2440 IF OT(NOUT,2)=1 THEN PRINT#3,DCT1$(SEL) ELSE PRINT#3,DCT2$(SEL)
  324. 2450 NOUT=NOUT+1
  325. 2460 GOTO 2370
  326. 2461 RETURN '----------
  327. 2462 'DEFAULT ORDER SUB -----------
  328. 2463 FOR I=1 TO CTR1 : OT(I,1)=I : OT(I,2)=1 : PRINT#3,DCT1$(I) : NEXT
  329. 2464 FOR I=1 TO CTR2 : OT(I+CTR1,1)=I : OT(I+CTR1,2)=2 : PRINT#3,DCT2$(I) :NEXT
  330. 2465 NOUT=CTR1+CTR2
  331. 2466 RETURN '--------
  332. 2470 CLOSE#3
  333. 2480 OPEN "O",#3,OUTFILE$+".TXT"
  334. 2485 CTR=0
  335. 2490 IF EOF(1) AND EOF(2) THEN CLOSE : PRINT CTR;" RECORDS OUTPUT" : INPUT "HIT RETURN TO CONTINUE.",DUM$ : GOTO 40
  336. 2500 IF EOF(1) OR EOF(2) THEN GOSUB 2560
  337. 2510 GOSUB 2600 'IN 1
  338. 2520 GOSUB 2650 'IN 2
  339. 2530 GOSUB 2700 'OUT
  340. 2540 CTR=CTR+1
  341. 2550 GOTO 2490
  342. 2560 PRINT "MATCH FAILURE ON INPUT FILES. ID1=";ID1$;"  ID2=";ID2$
  343. 2570 CLOSE : KILL OUTFILE$+".TXT" : KILL OUTFILE$+".DCT"
  344. 2580 PRINT "OUTPUT FILE : "+OUTFILE$+" DELETED."
  345. 2590 INPUT "HIT RETURN TO CONTINUE.",DUM$ : GOTO 40
  346. 2600 INPUT#1,ID1$
  347. 2610 FOR I=1 TO CTR1
  348. 2620   INPUT#1,F1(I),D1(I)
  349. 2630 NEXT
  350. 2640 RETURN '-------
  351. 2650 INPUT#2,ID2$
  352. 2660 FOR I=1 TO CTR2
  353. 2670   INPUT#2,F2(I),D2(I)
  354. 2680 NEXT
  355. 2690 RETURN '---------
  356. 2700 PRINT#3,ID1$;",";
  357. 2710 PRINT ID1$;" MATCHED"
  358. 2720 FOR I=1 TO NOUT-1
  359. 2730   J=OT(I,1)
  360. 2740   IF OT(I,2)=1 THEN PRINT#3,F1(J);",";D1(J);","; ELSE PRINT#3,F2(J);",";D2(J);",";
  361. 2750 NEXT
  362. 2760 J=OT(NOUT,1) : IF OT(NOUT,2)=1 THEN PRINT#3,F1(J);",";D1(J) ELSE PRINT#3,F2(J);",";D2(J)
  363. 2770 RETURN '---------
  364. 2780 'SUB TO APPEND NAMES AND CODES
  365. 2781 CLS
  366. 2783 PRINT "WARNING : USE THIS FUNCTION ONLY AFTER ALL PARTITIONS AND RECOMBINATIONS"
  367. 2784 PRINT "HAVE BEEN COMPLETED. OUTPUT FILES PRODUCED BY THIS FUNCTION CANNOT BE"
  368. 2785 PRINT "USED AS INPUT FOR FURTHER PARTITIONS AND RECOMBINATIONS USING THIS SYSTEM"
  369. 2786 PRINT "------------------------------------------------------------------------
  370. 2787 PRINT "COPIES OF MATCHING RECORDS FROM THE GEOGRAPHIC REFERENCE FILE WILL BECOME
  371. 2788 PRINT "THE FIRST PART OF EACH OUTPUT RECORD. COPIES OF THE DATA RECORDS
  372. 2789 PRINT "EXCLUDING THE STATE-COUNTY CODES WILL BECOME THE SECOND PART OF EACH
  373. 2790 PRINT "OUTPUT RECORD.
  374. 2791 PRINT '---------------------------
  375. 2793 INPUT "ENTER NAME OF DATA FILE : ",FILE$
  376. 2795 IF INSTR(FILE$,".") THEN GOSUB 3280 : GOTO 2790
  377. 2800 FLAG=0 : OPEN "I",#2,FILE$+".TXT"
  378. 2810 IF FLAG=1 THEN GOSUB 3190 : GOTO 2790
  379. 2812 INPUT "ENTER NAME OF OUTPUT FILE : ",OUTFILE$
  380. 2814 IF INSTR(OUTFILE$,".") THEN GOSUB 3280 : GOTO 2812
  381. 2816 OPEN "O",#3,OUTFILE$
  382. 2820 PRINT "INSERT DISK CONTAINING GEOGRAPHIC REFERENCE FILE INTO DRIVE A.
  383. 2830 INPUT "HIT RETURN WHEN READY.",DUM$
  384. 2835 INPUT "ENTER NAME OF GEOGRAPHIC REFERENCE FILE : ",NAMEFILE$
  385. 2837 IF INSTR(NAMEFILE$,".") THEN PRINT "DO NOT USE EXTENSION." : INPUT "HIT RETURN TO CONTINUE.",DUM$ : GOTO 2835
  386. 2840 FLAG=0 : OPEN "I",#1,NAMEFILE$+".TXT"
  387. 2842 IF FLAG=1 THEN PRINT "FILE NOT FOUND ON DRIVE INDICATED." : INPUT "HIT RETURN TO CONTINUE.",DUM$ : GOTO 2835
  388. 2850 CTR=0
  389. 2860 WHILE NOT (EOF(1) OR EOF(2))
  390. 2870   LINE INPUT#2,B$
  391. 2880   X=INSTR(B$,",")-1
  392. 2890   A$=" "
  393. 2900   WHILE LEFT$(A$,X)<>LEFT$(B$,X)
  394. 2910     LINE INPUT#1,A$
  395. 2920   WEND
  396. 2930   PRINT#3,A$+MID$(B$,X+1)
  397. 2940   CTR=CTR+1
  398. 2950   PRINT "MATCH ";CTR;LEFT$(B$,X)
  399. 2960 WEND
  400. 2970 IF EOF(1) AND NOT EOF(2) THEN PRINT "ERROR. EOF ON GEOREF FILE WITH RECORDS REMAINING ON DATA FILE." : PRINT "OUTPUT FILE DELETED." : KILL OUTFILE$ : INPUT "HIT RETURN TO CONTINUE.",DUM$ : GOTO 40
  401. 2995 CLOSE
  402. 2997 PRINT "NAMES AND CODES ADDED TO ";CTR;" RECORDS"
  403. 2998 INPUT "HIT RETURN TO CONTINUE.",DUM$
  404. 2999 GOTO 40 '------
  405. 3000 '--- ERROR ROUTINE ----------
  406. 3010 IF ERR<>0 THEN PRINT "ERROR ";ERR : FLAG=1
  407. 3012 IF ERR=22 THEN 3020
  408. 3013 IF ERR=53 THEN 3020
  409. 3018 ON ERROR GOTO 0
  410. 3020 RESUME NEXT  '--------------
  411. 3030 'SUB NUMERIC(DUM$)  FLAG=IF NUMERIC THEN 0 ELSE 1
  412. 3040 FLAG=0 : IF LEN(DUM$)=0 THEN FLAG=1 : GOTO 3090
  413. 3050 FOR X=1 TO LEN(DUM$)
  414. 3060   TEMP=ASC(MID$(DUM$,X,1))
  415. 3070   IF TEMP<ASC("0") OR TEMP>ASC("9") THEN FLAG=1 : GOTO 3090
  416. 3080 NEXT
  417. 3090 RETURN '----------
  418. 3100 'SUB TO CHECK YORN$ (YES/NO RESPONSE) FLAG=IF INVALID -1, YES 0, NO 1
  419. 3110 FLAG=0
  420. 3120 IF NOT (INSTR(YORN$,"Y")>0 OR INSTR(YORN$,"y")>0 OR INSTR(YORN$,"N")>0 OR INSTR(YORN$,"n")>0) THEN FLAG=-1 : GOTO 3140
  421. 3130 IF INSTR(YORN$,"N") OR INSTR(YORN$,"n") THEN FLAG=1
  422. 3140 RETURN '----------
  423. 3150 'INPUT ERROR MESSAGE
  424. 3160 INPUT "INPUT ERROR. HIT RETURN TO CONTINUE.",DUM$
  425. 3170 RETURN '-----------
  426. 3180 '---- MESSAGE SUBS -------------
  427. 3190 PRINT "DATA FILE NOT AVAILABLE ON DRIVE INDICATED.
  428. 3200 INPUT "HIT RETURN TO TRY AGAIN. HIT 'X' THEN RETURN TO CANCEL REQUEST.",DUM$
  429. 3210 IF LEN(DUM$)>0 THEN 40
  430. 3220 RETURN '--------
  431. 3230 'SUB
  432. 3240 PRINT "DICTIONARY FILE NOT FOUND ON DRIVE INDICATED
  433. 3250 INPUT "HIT RETURN TO TRY AGAIN. HIT 'X' THEN RETURN TO CANCEL REQUEST.",DUM$
  434. 3260 IF LEN(DUM$)>0 THEN 40
  435. 3270 RETURN '--------
  436. 3280 PRINT "DO NOT USE EXTENSION.
  437. 3290 INPUT "HIT RETURN TO CONTINUE.",DUM$
  438. 3300 RETURN '--------
  439. 3310 IF ERR=70 THEN PRINT "DISK TO RECEIVE OUTPUT FILE IS WRITE PROTECTED." : INPUT "HIT RETURN TO CONTINUE.",DUM$
  440. 3320 RETURN '--------
  441. 3330 '--- END MESSAGE SUBS ---------
  442.